home *** CD-ROM | disk | FTP | other *** search
/ Openstep 4.2 (Developer) / Openstep Developer 4.2.iso / NextDeveloper / Source / GNU / perl / Perl / vms / ext / VMS / stdio / stdio.xs < prev   
Encoding:
Text File  |  1995-05-22  |  3.1 KB  |  111 lines
  1. /* VMS::stdio - VMS extensions to stdio routines 
  2.  *
  3.  * Version:  1.1
  4.  * Author:   Charles Bailey  bailey@genetics.upenn.edu
  5.  * Revised:  09-Mar-1995
  6.  *
  7.  *
  8.  * Revision History:
  9.  * 
  10.  * 1.0  29-Nov-1994  Charles Bailey  bailey@genetics.upenn.edu
  11.  *      original version - vmsfopen
  12.  * 1.1  09-Mar-1995  Charles Bailey  bailey@genetics.upenn.edu
  13.  *      changed calling sequence to return FH/undef - like POSIX::open
  14.  *      added fgetname and tmpnam
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19. #include "XSUB.h"
  20.  
  21. /* Use type for FILE * from Perl's XSUB typemap.  This is a bit
  22.  * of a hack, since all Perl filehandles using this type will permit
  23.  * both read & write operations, but it saves having to write the PPCODE
  24.  * directly for updating the Perl filehandles.
  25.  */
  26. typedef FILE * InOutStream;
  27.  
  28. MODULE = VMS::stdio  PACKAGE = VMS::stdio
  29.  
  30. void
  31. vmsfopen(name,...)
  32.     char *    name
  33.     CODE:
  34.         char *args[8],mode[5] = {'r','\0','\0','\0','\0'}, c;
  35.         register int i, myargc;
  36.         FILE *fp;
  37.         if (items > 9) {
  38.           croak("File::VMSfopen::vmsfopen - too many args");
  39.         }
  40.         /* First, set up name and mode args from perl's string */
  41.         if (*name == '+') {
  42.           mode[1] = '+';
  43.           name++;
  44.         }
  45.         if (*name == '>') {
  46.           if (*(name+1) == '>') *mode = 'a', name += 2;
  47.           else *mode = 'w',  name++;
  48.         }
  49.         else if (*name == '<') name++;
  50.         myargc = items - 1;
  51.         for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na);
  52.         /* This hack brought to you by C's opaque arglist management */
  53.         switch (myargc) {
  54.           case 0:
  55.             fp = fopen(name,mode);
  56.             break;
  57.           case 1:
  58.             fp = fopen(name,mode,args[0]);
  59.             break;
  60.           case 2:
  61.             fp = fopen(name,mode,args[0],args[1]);
  62.             break;
  63.           case 3:
  64.             fp = fopen(name,mode,args[0],args[1],args[2]);
  65.             break;
  66.           case 4:
  67.             fp = fopen(name,mode,args[0],args[1],args[2],args[3]);
  68.             break;
  69.           case 5:
  70.             fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4]);
  71.             break;
  72.           case 6:
  73.             fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5]);
  74.             break;
  75.           case 7:
  76.             fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]);
  77.             break;
  78.           case 8:
  79.             fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
  80.             break;
  81.         }
  82.         ST(0) = sv_newmortal();
  83.         if (fp != NULL) {
  84.            GV *gv = newGVgen("VMS::stdio");
  85.                c = mode[0]; name = mode;
  86.                if (mode[1])  *(name++) = '+';
  87.                if (c == 'r') *(name++) = '<';
  88.                else {
  89.                  *(name++) = '>';
  90.                  if (c == 'a') *(name++) = '>';
  91.                }
  92.                *(name++) = '&';
  93.            if (do_open(gv,mode,name - mode,fp))
  94.              sv_setsv(ST(0),newRV((SV*)gv));
  95.         }
  96.  
  97. char *
  98. fgetname(fp)
  99.     FILE *    fp
  100.     CODE:
  101.       char fname[257];
  102.       ST(0) = sv_newmortal();
  103.       if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
  104.  
  105. char *
  106. tmpnam()
  107.     CODE:
  108.       char fname[L_tmpnam];
  109.       ST(0) = sv_newmortal();
  110.       if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname);
  111.